home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / InsideBa1994 / InsideBasic-94 / IB 94 / After Dark / Bouncing Ball.bas next >
BASIC Source File  |  1993-04-10  |  14KB  |  356 lines

  1. 'Generic After Dark module
  2. 'Written by Jonathan E. Durkee
  3. RESOURCES "Bouncing Ball.res", "ADgmADrk", "ADgm", 0, "BallBounce", _resPurgeable _resSysHeap
  4. COMPILE 0, _sysHeapVars _pointerVars
  5. OUTPUT FILE "Bouncing Ball/FB"
  6.  
  7. '*****************define variables constants & globals*************
  8. DIM RECORD monitorData
  9.   DIM monitorRect.8
  10.   DIM synchFlag%
  11.   DIM curDepth%
  12. DIM END RECORD.monitorData
  13.  
  14. DIM RECORD MonitorsInfo
  15.   DIM monitorCount%
  16.   DIM monitorList.monitorData
  17. DIM END RECORD.MonitorsInfo
  18.  
  19. DIM RECORD ctrlArray
  20.   DIM item1%
  21.   DIM item2%
  22.   DIM item3%
  23.   DIM item4%
  24. DIM END RECORD.ctrlArray
  25. 'The array of controls in the AD control panel
  26.  
  27. DIM RECORD qdGlobals
  28.   DIM qdThePort&
  29.   DIM qdWhite.8
  30.   DIM qdBlack.8
  31.   DIM qdGray.8
  32.   DIM qdLtGray.8
  33.   DIM qdDkGray.8
  34.   DIM qdArrow.16
  35.   DIM qdScreenBits&
  36.   DIM qdRandSeed&
  37. DIM END RECORD.qdGlobals
  38.  
  39. DIM RECORD GMParamBlockRec
  40.   DIM controlValues.ctrlArray           'var for control values
  41.   DIM monitors&                         'handle for monitor data
  42.   DIM colorQDAvail%                     'is color quickdraw available?
  43.   DIM systemConfig%                     'system configuration bytes
  44.   DIM qdGlobalsCopy&                    'pointer to quickdraw globals
  45.   DIM brightness%                       'field for storing screen brightness value
  46.   DIM demoRect.8                        'rect of "Demo" window in AD control panel
  47.   DIM errorMessage&                     'handle to field for error message
  48.   DIM sndChannel&                       'channel for sound playing
  49.   DIM adVersion%                        'after dark version
  50. DIM END RECORD.GMParamBlockRec
  51. 'That's the Main Param Block Record. Got all sorts of interesting
  52. 'info.
  53.  
  54. 'Messages passed to the module by After Dark
  55. _initialize=0
  56. _moduleClose=1
  57. _blank=2
  58. _drawFrame=3
  59. _moduleSelected=4
  60. _doHelp=5
  61. _chooseColorButton=9
  62. 'Messages passed to After Dark by the module
  63. _moduleError=-1
  64. _noProblem=0
  65. _restartMe=1
  66. _imDone=2
  67. _refreshResources=3
  68. 'Other constants needed by the program
  69. _resID=128                              'resource ID for the RGBv resource
  70. _minValue=3                             'minimum speed for ball, also minimum size
  71.  
  72. DIM ballRect.8                          'the ball's position
  73. DIM ballColor.6                         'ball's color
  74. DIM ballH%,ballV%                       'horz & vert velocities
  75. DIM ballDirH%,ballDirV%                 'these two are always 1 or -1 for the direction of ball's movement
  76. DIM oldBallRgn&,newBallRgn&,trailingRgn&'regions used to draw the ball
  77.  
  78. END GLOBALS                             'all done with global vars & constants
  79.  
  80. '*****************Useful, transportable functions here*************
  81. CLEAR LOCAL MODE
  82. DIM tempPramBlock.GMParamBlockRec
  83. LOCAL FN mainMonitorDepth(paramBlockPtr&)
  84.   BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
  85.   LONG IF tempPramBlock.colorQDAvail%
  86.     'do we have color quickdraw? if so then find the color depth.
  87.     colorDepth=PEEK WORD(PEEK LONG(PEEK LONG(PEEK LONG(FN GETMAINDEVICE)+22))+32)
  88.   XELSE
  89.     'if there's no color quickdraw, bit depth is always going to be 1.
  90.     colorDepth=1
  91.   END IF
  92. END FN=colorDepth
  93.  
  94.  
  95.  
  96. CLEAR LOCAL MODE
  97. DIM tempPramBlock.GMParamBlockRec
  98. DIM tempMonitorBlock.monitorsInfo
  99. LOCAL FN mainMonitorH(paramBlockPtr&)
  100.   BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
  101.   BLOCKMOVE tempPramBlock.monitors&,@tempMonitorBlock,_monitorsInfo
  102. END FN=tempMonitorBlock.monitorList.monitorRect.right%
  103.  
  104. CLEAR LOCAL MODE
  105. DIM tempPramBlock.GMParamBlockRec
  106. DIM tempMonitorBlock.monitorsInfo
  107. LOCAL FN mainMonitorV(paramBlockPtr&)
  108.   BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
  109.   BLOCKMOVE tempPramBlock.monitors&,@tempMonitorBlock,_monitorsInfo
  110. END FN=tempMonitorBlock.monitorList.monitorRect.bottom%
  111.  
  112. CLEAR LOCAL MODE
  113. LOCAL FN setDirection(direction%,variable%)
  114.   'Use this function if you have a velocity of unknown direction, and you want
  115.   'to set it to a known direction. (not used in Bouncing Ball - here for your convenience only)
  116.   LONG IF direction%=-1
  117.     IF variable%<0 THEN nuVelocity%=variable%'leave it alone
  118.     IF variable%>0 THEN nuVelocity%=variable%*-1'flip it the other way
  119.   END IF
  120.   LONG IF direction%=1
  121.     IF variable%<0 THEN nuVelocity%=variable%*-1
  122.     IF variable%>0 THEN nuVelocity%=variable%
  123.   END IF
  124.   'if direction% was not =1 or =-1, we ignore it - must have been a syntax error.
  125. END FN=nuVelocity%
  126.  
  127. CLEAR LOCAL MODE
  128. 'use this function to report a problem to After Dark when your module can't run
  129. DIM tempPramBlock.GMParamBlockRec
  130. LOCAL FN errorMessage(paramBlockPtr&,complaint$)
  131.   BLOCKMOVE paramBlockPtr&,@tempPramBlock,_GMParamBlockRec
  132.   BLOCKMOVE @complaint$, tempPramBlock.errorMessage&, LEN(complaint$)+1
  133. END FN
  134.  
  135. '************Bouncing Ball-specific functions*******************
  136. CLEAR LOCAL
  137. LOCAL FN newSpeeds(totalSpeed%)
  138.   'This function sets up two new speeds. The sum of the two is equal to whatever
  139.   'the user selected in the control panel as the ball's speed.
  140.   'IF totalSpeed%<2 THEN totalSpeed%=2   'don't give impossibly small values
  141.   ballH%=RND(totalSpeed%)
  142.   ballV%=totalSpeed%-ballH%
  143. END FN
  144.  
  145. CLEAR LOCAL MODE
  146. LOCAL FN slider(controlPanelValue%)
  147.   'This function is used whenever data is needed from one of the two control panel sliders.
  148.   'It simply makes sure that the value is not lower than a minimum value set as a constant.
  149.   IF controlPanelValue%<_minValue THEN realValue%=_minValue ELSE realValue%=controlPanelValue%
  150. END FN=realValue%
  151.  
  152. CLEAR LOCAL
  153. LOCAL FN tweekSpeeds(newSpeed%)
  154.   oldSpeed%=ballH%+ballV%
  155.   'figure out what the old control panel value was
  156.   diff%=newSpeed%-oldSpeed%
  157.   splitDiff%=diff%/2
  158.   ballH%=ballH%+splitDiff%
  159.   ballV%=newSpeed%-ballH%
  160.   'This function is used whenever the user changes control panel values and our module
  161.   'is running (only happens in demo mode). What it does is to change the ball speeds so
  162.   'that the ball travels in (nearly) the same direction, but at a rate proportional to
  163.   'the new Control Panel slider value.
  164. END FN
  165.  
  166. CLEAR LOCAL
  167. DIM tempPramBlock.GMParamBlockRec
  168. LOCAL FN doInitialize(storage&,blankrgn&,paramblockptr&)
  169.   result%=_noProblem
  170.   storage&=FN NEWHANDLE(2)
  171.   'allocate a new handle of two bytes. We won't use this handle - it's just
  172.   'there to keep After Dark from panicking and thinking the module had a
  173.   'problem while initializing. (After Dark doesn't like nil handles any more than you do.)
  174.   BLOCKMOVE paramblockptr&,@tempPramBlock,_GMParamBlockRec
  175.   'get the parameter block into tempPramBlock
  176.   LONG IF storage&<>0
  177.     'let's set up variables, etc.
  178.     oldBallRgn&=FN NEWRGN:newBallRgn&=FN NEWRGN:trailingRgn&=FN NEWRGN
  179.     'create new regions, to be used when drawing the ball
  180.     LONG IF oldBallRgn&<>0 AND newBallRgn&<>0 AND trailingRgn&<>0
  181.       'now set up some random values for the ball to start with
  182.       ballRect.top%=RND(FN mainMonitorV(paramblockptr&))
  183.       ballRect.left%=RND(FN mainMonitorH(paramblockptr&))
  184.       ballRect.bottom%=ballRect.top%+tempPramBlock.controlValues.item1%
  185.       ballRect.right%=ballRect.left%+tempPramBlock.controlValues.item1%
  186.       'make a randomly positioned rectangle on the main monitor, set to the size
  187.       'requested by the user
  188.       FN newSpeeds(tempPramBlock.controlValues.item2%)
  189.       IF RND(2)=1 THEN ballDirH%=1 ELSE ballDirH%=-1
  190.       IF RND(2)=1 THEN ballDirV%=1 ELSE ballDirV%=-1
  191.       'Set up random directions for the ball to drift in
  192.     XELSE
  193.       result%=_moduleError
  194.       FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not get enough memory.")
  195.     END IF
  196.   XELSE
  197.     result%=_moduleError
  198.     FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, an error occured while allocating memory.")
  199.     'Whoops, no memory available. Close module & give an error message.
  200.   END IF
  201. END FN=result%
  202.  
  203. CLEAR LOCAL
  204. DIM tempPramBlock.GMParamBlockRec
  205. LOCAL FN doBlank(blankrgn&,paramblockptr&)
  206.   BLOCKMOVE paramblockptr&,@tempPramBlock,_GMParamBlockRec
  207.   
  208.   'first get the ball's RGB color value from the "RGBv" resource. The reason we are
  209.   'doing this here instead of in FN doInitialize is because the user may have changed the
  210.   'color since the last time the module activated.
  211.   resHndl&=FN GETRESOURCE(_"RGBv",_resID)
  212.   LONG IF resHndl&<>0
  213.     BLOCKMOVE [resHndl&],@ballColor,_RGBColor
  214.     CALL RELEASERESOURCE(resHndl&)      'trash the resource handle
  215.     'move an RGBColor record into ballColor from the resource
  216.   XELSE
  217.     result%=_moduleError
  218.     'We couldn't load the Ball Color resource in, so post an error message
  219.     'and cancel the program.
  220.     FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not load a necessary resource.")
  221.   END IF
  222.   
  223.   
  224.   CALL PAINTRGN(blankrgn&)
  225.   LONG IF tempPramBlock.colorQDAvail%<>_false
  226.     CALL RGBFORECOLOR(ballColor.red%)
  227.   XELSE
  228.     CALL PENMODE(_srcXor)
  229.   END IF
  230.   CALL PAINTOVAL(ballRect)
  231. END FN=_noProblem                       'no problems possible in this function
  232.  
  233. LOCAL FN doClose(storage&,blankrgn&,paramblockptr&)
  234.   'All that needs to be done here is to dispose of the handle allocated in doInitialize,
  235.   CALL DISPOSERGN(oldBallRgn&):CALL DISPOSERGN(newBallRgn&):CALL DISPOSERGN(trailingRgn&)
  236.   'and to dispose of the regions.
  237. END FN=FN DISPOSHANDLE(storage&)
  238.  
  239. CLEAR LOCAL
  240. DIM tempPramBlock.GMParamBlockRec
  241. DIM newPosition.8
  242. DIM blackColor.RGBColor
  243. LOCAL FN drawFrame(blankRgn&,paramBlock&)
  244.   result%=_noProblem:CALL PENNORMAL
  245.   BLOCKMOVE @ballRect,@newPosition,8
  246.   BLOCKMOVE paramBlock&,@tempPramBlock,_GMParamBlockRec
  247.   'copy old position to new
  248.   CALL OFFSETRECT(newPosition,ballH%*ballDirH%,ballV%*ballDirV%)
  249.   'multiply the absolute speed times the direction to get the offset amount
  250.   LONG IF newPosition.bottom%-newPosition.top%<>FN slider(tempPramBlock.controlValues.item1%)
  251.     'basically this is asking if the slider for "ball size" has changed since last check
  252.     newPosition.bottom%=newPosition.top%+FN slider(tempPramBlock.controlValues.item1%)
  253.     newPosition.right%=newPosition.left%+FN slider(tempPramBlock.controlValues.item1%)
  254.   END IF
  255.   LONG IF ballH%+ballV%<>FN slider(tempPramBlock.controlValues.item2%)
  256.     'has the user changed ball speed since we last checked? if so, we must speed
  257.     'up or slow down the ball accordingly.
  258.     FN tweekSpeeds(FN slider(tempPramBlock.controlValues.item2%))
  259.   END IF
  260.   'This next part might be a bit confusing. If you don't understand it, it's just a method
  261.   'of reducing flicker. What we do is to calculate a region, which is the exact area of 
  262.   'the old ball that is not covered by the new. We black only that part out, then draw
  263.   'the new ball.
  264.   CALL PENMODE(_srcCopy)
  265.   CALL OPENRGN
  266.   CALL FRAMEOVAL(ballRect.top%)
  267.   CALL CLOSERGN(oldBallRgn&)
  268.   CALL OPENRGN
  269.   CALL FRAMEOVAL(newPosition.top%)
  270.   CALL CLOSERGN(newBallRgn&)
  271.   'Now we have two regions, one for each ball position. Next calculate the difference:
  272.   CALL DIFFRGN(oldBallRgn&,newBallRgn&,trailingRgn&)
  273.   'blank out whatever part of the old region is not going to be used in the new
  274.   'now draw the new ball - depending on whether the machine is in color or not
  275.   LONG IF FN mainMonitorDepth(paramBlock&)>1
  276.     'are we in color mode? if so then draw the ball in color
  277.     CALL RGBFORECOLOR(blackColor.red%)
  278.     'this is a trick done by the CLEAR LOCAL at the beginning of this FN.
  279.     'since blackColor is cleared to all zeros, it automatically equals black. so
  280.     'we don't have to worry about putting values into it.
  281.     CALL PAINTRGN(trailingRgn&)
  282.     CALL RGBFORECOLOR(ballColor.red%)
  283.     CALL PAINTRGN(newBallRgn&)
  284.   XELSE
  285.     CALL PAINTRGN(trailingRgn&)
  286.     CALL ERASERGN(newBallRgn&)
  287.   END IF
  288.   BLOCKMOVE @newPosition,@ballRect,8
  289.   'move the new position back into the old
  290.   'now check to make sure that the ball is not off the screen - if it is, change its direction
  291.   changedFlag%=_false
  292.   IF ballRect.top%<blankRgn&..rgnBbox.top% THEN ballDirV%=1:changedFlag%=_true
  293.   IF ballRect.bottom%>blankRgn&..rgnBbox.bottom% THEN ballDirV%=-1:changedFlag%=_true
  294.   IF ballRect.left%<blankRgn&..rgnBbox.left% THEN ballDirH%=1:changedFlag%=_true
  295.   IF ballRect.right%>blankRgn&..rgnBbox.right% THEN ballDirH%=-1:changedFlag%=_true
  296.   IF changedFlag=_true THEN FN newSpeeds(FN slider(tempPramBlock.controlValues.item2%))
  297.   'if the ball hit the wall, then change the proportion of horizontal to vertical speed
  298. END FN=result%
  299.  
  300. CLEAR LOCAL
  301. DIM dialogPoint.4
  302. DIM newColor.RGBColor
  303. DIM oldColor.RGBColor
  304. LOCAL FN chooseColor(paramblockptr&)
  305.   result%=_noProblem
  306.   resHndl&=FN GETRESOURCE(_"RGBv",_resID)
  307.   LONG IF resHndl&<>0
  308.     BLOCKMOVE [resHndl&],@oldColor,_RGBColor
  309.     'move an RGBColor record into oldColor from the resource
  310.     CALL SETPT(dialogPoint,125,75)
  311.     'set the point where the color picker should go
  312.     colorPicked%=FN GETCOLOR(dialogPoint,"Pick a color for the ball:",oldColor,newColor)
  313.     LONG IF colorPicked%                '
  314.       'Did the user pick a new color or just cancel?
  315.       'If there was a new color, let's save it to disk.
  316.       BLOCKMOVE @newColor,[resHndl&],_RGBColor
  317.       CALL CHANGEDRESOURCE(resHndl&)
  318.       'move the color into the resource & save to disk
  319.     XELSE
  320.       'user cancelled dialog so we do nothing
  321.     END IF
  322.     CALL RELEASERESOURCE(resHndl&)
  323.     'close the resource & free up memory again
  324.   XELSE
  325.     result%=_moduleError
  326.     'We couldn't load the Ball Color resource in, so post an error message
  327.     'and cancel the program.
  328.     FN errorMessage(paramblockptr&,"Bouncing Ball: Sorry, could not load a necessary resource.")
  329.   END IF
  330. END FN=result%
  331.  
  332. '********************Here's the main program*****************
  333. ENTERPROC% (StorageHndl&, BlankRgn&, Message%, ParamBlock&)
  334.   SELECT Message%
  335.       'Which message was received by the module?
  336.     CASE _initialize
  337.       result=FN doInitialize(StorageHndl&,BlankRgn&,ParamBlock&)
  338.     CASE _moduleClose
  339.       result=FN doClose(StorageHndl&,BlankRgn&,ParamBlock&)
  340.     CASE _blank
  341.       result=FN doBlank(BlankRgn&,ParamBlock&)
  342.     CASE _drawFrame
  343.       result=FN drawFrame(BlankRgn&,ParamBlock&)
  344.     CASE _moduleSelected
  345.     CASE _doHelp
  346.     CASE _chooseColorButton
  347.       result=FN chooseColor(ParamBlock&)
  348.   END SELECT
  349. EXITPROC%=result
  350. RETURN
  351.  
  352.  
  353.  
  354.  
  355.  
  356.